;; core/defineV.scm - (c) rohan drape, 2000-2005

;; A syntax that binds name* to name and installs the new binding at
;; name.

(define-syntax defineV
  (lambda (x)
    (define (add-star name)
      (datum->syntax-object
       name
       (string->symbol 
	(string-append (symbol->string (syntax-object->datum name)) "*"))))
    (syntax-case 
	x ()
      ((_ (name) e ...) 
       (with-syntax ((name* (add-star (syntax name))))
		    (syntax (begin (define name* name)
				   (set! name (lambda () e ...))))))
      ((_ (name a ...) e ...) 
       (with-syntax ((name* (add-star (syntax name))))
		    (syntax (begin
			      (define name* name)
			      (set! name (lambda (a ...) e ...))))))
      ((_ name expr) 
       (with-syntax ((name* (add-star (syntax name))))
		    (syntax (begin (define name* name)
				   (set! name expr))))))))
